home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / mosmllib / Word.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  5.5 KB  |  149 lines  |  [TEXT/Moml]
  1. (* Word -- new basis 1994-11-01, 1995-04-06, 1995-07-12, 1996-04-01 *)
  2.  
  3. (* This unit relies on two's complement representation *)
  4.  
  5. type word = word;
  6.  
  7. val wordSize = 31;
  8.  
  9. local
  10.     prim_val orb_       : word -> word -> word = 2 "or";
  11.     prim_val andb_      : word -> word -> word = 2 "and";
  12.     prim_val xorb_      : word -> word -> word = 2 "xor";
  13.     prim_val lshift_    : word -> word -> word = 2 "shift_left";
  14.     prim_val rshiftsig_ : word -> word -> word = 2 "shift_right_signed";
  15.     prim_val rshiftuns_ : word -> word -> word = 2 "shift_right_unsigned";
  16.  
  17. in
  18.  
  19.     prim_val toInt   : word -> int = 1 "identity";
  20.     prim_val toIntX  : word -> int = 1 "identity";
  21.     prim_val fromInt : int -> word = 1 "identity";
  22.  
  23.     prim_val toLargeInt   : word -> int = 1 "identity";
  24.     prim_val toLargeIntX  : word -> int = 1 "identity";
  25.     prim_val fromLargeInt : int -> word = 1 "identity";
  26.  
  27.     prim_val toLargeWord   : word -> word = 1 "identity";
  28.     prim_val toLargeWordX  : word -> word = 1 "identity";
  29.     prim_val fromLargeWord : word -> word = 1 "identity";
  30.  
  31.     fun orb (x, y)  = orb_ x y;
  32.     fun andb (x, y) = andb_ x y;
  33.     fun xorb (x, y) = xorb_ x y;
  34.     fun notb x      = xorb_ x (fromInt ~1); 
  35.  
  36.  
  37.     fun << (w, k) = 
  38.         if toInt k >= 31 orelse toInt k < 0 then fromInt 0
  39.         else lshift_ w k;
  40.  
  41.     fun >> (w, k) = 
  42.         if toInt k >= 31 orelse toInt k < 0 then fromInt 0
  43.         else rshiftuns_ w k;
  44.  
  45.     fun ~>> (w, k) = 
  46.         if toInt k >= 31 orelse toInt k < 0 then 
  47.             if toInt w >= 0 then        (* msbit = 0 *)
  48.                 fromInt 0
  49.             else                        (* msbit = 1 *)
  50.                 fromInt ~1
  51.         else    
  52.             rshiftsig_ w k;
  53.  
  54.     val op *    : word * word -> word = op *;
  55.     val op +    : word * word -> word = op +;
  56.     val op -    : word * word -> word = op -;
  57.     val op div  : word * word -> word = op div;
  58.     val op mod  : word * word -> word = op mod;
  59.  
  60.     local 
  61.       open StringCvt
  62.       fun skipWSget getc source = getc (dropl Char.isSpace getc source)
  63.  
  64.       (* Below, 48 = Char.ord #"0" and 55 = Char.ord #"A" - 10. *)
  65.       fun decval c = fromInt (Char.ord c) - fromInt 48;
  66.       fun hexval c = 
  67.           if #"0" <= c andalso c <= #"9" then 
  68.               fromInt (Char.ord c) - fromInt 48
  69.           else 
  70.               (fromInt (Char.ord c) - fromInt 55) mod (fromInt 32);
  71.  
  72.       fun prhex i = 
  73.           if toInt i < 10 then Char.chr(toInt (i + fromInt 48))
  74.           else Char.chr(toInt (i + fromInt 55));
  75.  
  76.       fun conv radix i = 
  77.           let fun h n res = 
  78.                   if n = fromInt 0 then res
  79.                   else h (n div radix) (prhex (n mod radix) :: res)
  80.               fun tostr n = h (n div radix) [prhex (n mod radix)]
  81.           in String.implode (tostr i) end
  82.  
  83.     in
  84.       fun scan radix getc source =
  85.           let open StringCvt
  86.               val source = skipWS getc source
  87.               val (isDigit, factor) = 
  88.                   case radix of
  89.                       BIN => (fn c => (#"0" <= c andalso c <= #"1"),  2)
  90.                     | OCT => (fn c => (#"0" <= c andalso c <= #"7"),  8)
  91.                     | DEC => (Char.isDigit,                          10)
  92.                     | HEX => (Char.isHexDigit,                       16)
  93.               fun dig1 NONE              = NONE
  94.                 | dig1 (SOME (c1, src1)) = 
  95.                   let fun digr res src = 
  96.                           case getc src of
  97.                               NONE           => SOME (res, src)
  98.                             | SOME (c, rest) => 
  99.                                   if isDigit c then 
  100.                                       digr (fromInt factor * res + hexval c) 
  101.                                       rest
  102.                                   else SOME (res, src)
  103.                   in 
  104.                       if isDigit c1 then digr (hexval c1) src1 
  105.                       else NONE 
  106.                   end
  107.               fun getdigs after0 src = 
  108.                   case dig1 (getc src) of
  109.                       NONE => SOME(fromInt 0, after0)
  110.                     | res  => res
  111.               fun hexprefix after0 src =
  112.                   if radix <> HEX then getdigs after0 src
  113.                   else
  114.                       case getc src of
  115.                           SOME(#"x", rest) => getdigs after0 rest
  116.                         | SOME(#"X", rest) => getdigs after0 rest
  117.                         | SOME _           => getdigs after0 src
  118.                         | NONE => SOME(fromInt 0, after0)
  119.           in 
  120.               case getc source of
  121.                   SOME(#"0", after0) => 
  122.                       (case getc after0 of 
  123.                            SOME(#"w", src2) => hexprefix after0 src2 
  124.                          | SOME _           => hexprefix after0 after0 
  125.                          | NONE             => SOME(fromInt 0, after0))
  126.                 | SOME _ => dig1 (getc source)
  127.                 | NONE   => NONE 
  128.           end;
  129.  
  130.       fun fmt BIN = conv (fromInt  2)
  131.         | fmt OCT = conv (fromInt  8)
  132.         | fmt DEC = conv (fromInt 10)
  133.         | fmt HEX = conv (fromInt 16)
  134.  
  135.       fun toString w   = conv (fromInt 16) w
  136.       fun fromString s = scanString (scan HEX) s
  137.     end (* local for string functions *)
  138.  
  139.     fun min(w1 : word, w2) = if w1 > w2 then w2 else w1;
  140.     fun max(w1 : word, w2) = if w1 > w2 then w1 else w2;
  141.     fun compare (x, y: word) = 
  142.         if x<y then LESS else if x>y then GREATER else EQUAL;
  143.     val op >    : word * word -> bool = op >;
  144.     val op >=   : word * word -> bool = op >=;
  145.     val op <    : word * word -> bool = op <;
  146.     val op <=   : word * word -> bool = op <=;
  147.  
  148. end
  149.